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COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND he 


TRANSFERRED. 


THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
AND SHOULD NOT 
CORPORATION. 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS 


BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
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OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
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* 

* 
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NOT SUPPLIED BY DIGITAL. * 
* 
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* 
PASSRT_HEAP 
RUNTIME SUPPORT MODULE FOR PASCAL == SECTION 2 


VERSION V1.0-1 -= OCTOBER 1979 
This module defines the following routines: 


pas$new: routine to implement the Pascal procedure new(p) 

oot ohh pt routine to implement the Pascal procedure hh yO a 
pasS$mark: routine to implement the Pascal procedure mark(p) 
pas$release: routine to implement the Pascal procedure release(p) 
pas$snap: debug routine to examine state of the heap 


Written by: Jeff Scofield 10-Dec-78 
Edit Histor 


01-002 Paul Hohensee 27feb80. Modified to prevent duplicate 
error messages form printing. Eliminate for vl. 
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01-003 Susan Azibert 28may80. Shonged the printing of error 
messages so that they are both printed and signaled 
by calling Lib$stop. 


01-004 Susan Azibert 24sep80. Fixed bus introduced by change 
01-003 in outputting message attdisinv 


01-005 Paul Hohensee 11-Aug-81. Changed references to external routines to u_ 
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.title pas$rt_hea 
. ident 0704-000" ¢ 


-extrn pas$_proexchea 
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000 
00 
00 
000 
0000 
0000 
0000 
0000 
0000 
0000 
00000000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
00000000 00000000 0000 
00000000 00000000 0008 
00000000 00000000 0010 
00000000 00000000 0018 
00 0020 
0021 
00000000 
0000 
0000 
0000 
O3FC 0000 
0002 
0002 
0002 
00000020'EF 96 0002 
52 00000020'EF 9A 0008 
53 FFFFFFFC'EFS2 00 OO0F 
54 Q0000004'EF42 D0 0017 
55 QO0OO0000C"EF42 DO OOIF 
56 04 AC 00 0027 
0028 
0028 
0028 
0028 
57 D4 85 8 
58 53 vO 002d 
11 13 0030 
56 FC AB 01 0032 
03 IF 0036 
OOF 1 31 0038 
57 58 pd0 0038 
58 68 D0 OO3E 
EF 12 0041 
004 
Ope 
04 
004 
0043 
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mitt y 85:98:28 EPASCAL. SRCIPASRT2_ MAR: 1 " db v04 
-extrn pas$_attdisinv 


$stsdef 
NEW, DISPOSE, 


OWN STORAGE USED BY THE ROUTINES 
-psect _pas$data,pic,noexe,2 


pbl 


marks: pointers to the next block o 


ROUTINES TO IMPLEMENT THE PASCAL HEAP=MANAGEMENT PROCEDURES 
MARK, RELEASE 


Lsepet pointers to the Lists of available space for each level 
S$: pointers to the page block lists for each Level 


to be allocated by 


: pools: pointers to the pools of oe Pe e blocks for each level 


; procedure mark 
3 nestl: the nesting level 


lasps: «long 0 
pblps: .long 0 
pools: .long 0 
marks: .long 0 
nestl: .byte 0 


-psect _pas$code,pic,shr,exe,nowrt 
ROUTINE TO IMPLEMENT THE PASCAL STANDARD PROCEDURE NEW 


pointers to LAS's, initialized to nil | 
pointers to PBL's, initialized to nil 
pointers to pools, initialized to nil 


; pointers to marks, initialized to nil 
; re-entrancy level, initialized to 0 


-entry pas$new,“m<r2,r3,74,75,r6,r7,r8,r9> 


Move important values to registers 


incb nestl 
movzbl nestl,r 
movl Lasps-4(Cr2),r3 


movl pelos r2j,r4 
mov l ools-4(r2),r5 
movl (ap),ré 


clrl r7 

mov r3,r8 

beql inpool 
10$: capl -4(r8),r6 

blssu 208% 

brw alloc 
20$: movl r8or 

movl (r8) 8 

bneq 10$ 


Register 7 has address of Last 


Look through LAS for first block lar 
Register 7 finds the predecessor of 


increment nest level — 
r2 <= incremented —— level 
r3 <= LASP for this leve 
r4 <= PBLP for this level 

r5 <= addr of first block of pool 
r6 <- # of bytes to allocate 


e enough to satisfy the request. 
he block, r8 finds the block. | 


initialize the predecessor to nil 
initialize r8 to LASP 

LAS is erie other memory 
is this b och Se greugnt 
continue looking if no 

else take it 

no--try next block 


loop until found or end of LAS 


Block was_not found on LAS, gi to find block in pool that will do. 
f lock of LAS; r8 will find predecessor 
of page block, r9 will find page block in pool. 


-——-———--- - a 
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i try to find block in pool 
D4 ry; 114 rete clrl r 3 initialize predecessor to nil 
59 38 D $¢ 119 movl r vr : bd he pp a 2 anh 
| 50 FC Ad 5 boca 119 si ATE 480-669) 0 3 ro <- avell Space in this block 
| 56 0 Di QOO4F 120 cmpl r0,r6 3; is there room in this block? 
08 1& 0052 121 bgequ 208 > yes--Link new blk into LAS & PBL 
| 58 59 Mi 054~—1 mov r9,r8 ; no=-try next page block 
59 69 DO 0057 «1 § movil = (9) 9 
C 11 QOSA 124 brb 10$ ; loop until found or end of pool 
5 DS 005C 125 20$: tstl r8 ; is there a predecessor of pg block? 
05 13 5 1 beql 30$ 3; no--remove first block of PBL 
68 69 00 $6 1 § movl (r9), (r8) ; yes--link predecessor to successor 
48 11 006 128 brb Linkpb 3 Link page block into LAS & PBL 
55 669) = 0 0065S «129 «308: movl (r9),r5 ; remove first block of PBL 
43. «11 Ope 139 brb Linkpb ; link page block into LAS & PBL 
Bpea 13 : No block was found in pool. Expand program region to get new block. 
é : ; expand program region for memory 
58 56 00000207 BF oc bea 138 mem cats 519, 76.r8 S round (r6 % 8) up to Next 512 bytes 
58 OOOOO1FF 8F CA 0072 136 bicl #511,°8 : r8 <- # of bytes to ask for 
58 DD 0079 137 pushl r8 : ~4(fp) <- # of bytes to ask for 
59 7E DE O007B 138 moval <-(sp),r9 ; 79 <= addr of free longw on stack 
59 DD OO7E 139 pushl Fr9 3 push arg2: addr to get addr 
FC AD DF 0080 £140 pushal ~4(fp) 3; push argi: addr of # bytes asked for 
O0000000'GF O02 FB 0083 141 calls #2,G*lLib$get_vm 3 get memory; (r9) <- addr of mem 
1A 50 €8 OQOBA 142 blbs r0,10$ < 3; continue tj no errors 
7E 10 AD O7 (C3 OO08D 143 subl3 #7,16(fp),-(sp) ; third FAO argument (PC of call) 
00 dD 0092 144 pushl #0 : second FAO argument (null) 
00 ODD 0094 145 pushl #0 ; first FAO argument (null) 5 
03 DD 0096 146 pusht #3 ; number of FAO arguments preceding 
7E Q0000000'8F 04 C1 0098 £147 addl3 #4 ,#pas$ proexchea,-(sp) ; error message #8110 | 
00000000'GF 05 FB QOAO 148 calls #5,G*lib$stop ; signal error and stop execution 
59 69 DO OOA7 149 108: mov (r9) £9 ; 79 <= addr of new memory 
89 58 »d0 a 139 movl r8,(r9)+ ; set size of new block 
QOAD 13¢ : Link new page piock to i of fe. Rn ey Bed np te Fg e 
: » merge the two and se ag so that 
O0ap 134 : nae Wy ° Register 4 has addr at last page block, r9 has addr of 
QOOAD 155 ; new page block. 
Soap 139 Linkpb: ; link new page block to PBL 
51 D4 QOAD 158 clrl rl 3 rl is flag: init to 0 
54 D5 QOAF 159 tstl r4 : is PBL empty? 
13. 13 0081 # 160 beql 10$ : yes--Link new block to PBL 
50 54 FC AS C1 O0B3 161 addi3 _--4(r4),r4,r0 ; no--r0 <= addr of end of last blk 
50 59 D1 Q0B8 16 cmpl r9,r0 : is new block adjacent? 
09. = $0BB 188 bneq 10 : no--Link new block to PBL 
FC AS «FC AQ (6 Q0BD 164 addl2s_ -4(r9) ,-4(r4) : yes--Lengthen old block 
51 D6 O00C2 165 incl rl ; set flag to show merge done 
OF 11 QOC&4 16 brb Linkla ; go Link block into LAS 
69 54 00 00C6 189 10$: mov l r4,(r9) : Link new block to PBL 
54 59 dO QOC9 168 mov l r9.r4 ; set new head of PBL 
-— 8 ¢€ Occ 169 addl #8,°9 : 79 <= addr of new LAS block 
FC AD «FS AD 08 £8 Boss 109 subl #8,-12(r9) ,-4(r9) ; set Length of new LAS block 
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| 0D 176 3 Link new block into LAS, kept sorted in memory order, If ri = 1, 
0D 173 ; try to merge new vr with predecessor. og eaee 7 has addr of 
| 4 ie ; last block of LAS, r9 has address of new block. 
a03 178 Linkla: ; link new block into LAS 
| 58 D4 oa = ar clrl r8 3 set successor to ni 
57 59 D1 QOD? 178 cmpl r9,r7 ; new block goes at end of LAS? 
1g 1A QODA 179 bgtru 208 3 ygs7-g0 ahead and insert 
5 D4 OODC 180 clrl r7 : r? finds predecessor of block 
58 53 DO OODE 181 mov | r3,r8 ; 78 finds successor of block 
58 59 D1 QOE1 186 10$: cmpl r9,r8 ; does block belong here? 
08 1F OE, 18 blssu 20 t yes--insert 
57 DO OOE6 184 mov r8,r7 3 no--try after next block 
58 68 DO O0E9 185 movil = (8), r8 
F3 3 QOOEC 186 bneq 10$ : loop until found or end of List 
57 D5 OQOEE 187 208: tstl r7 ; is there a predecessor? 
$9 13 OOFO 188 beql 50$ 3 no--add to front of LAS 
se) ee, Boe g 189 blbc r1,40$ 3 do not merge if rtag clear 
50 57 FC A? C1 OOF 190 addl\3_-4(r7),r7,r0 ; f0 <- addr of end o predecessor 
50 59 D1 OOFA 191 cmpl r9,r0 ; is new block adjacent? 
17 «+12 OOFD 136 bneq 40 : no=-Link predecessor to block 
FC A? FC AD CO OOFF 19 addl2-_- =4(r9) ,-4(r7) 3 yes--lengthen predecessor 
59 57) =O 0104 =: 194 mov | r7.r ; use lengthened block 
- ae ee. eh a. movl r3,r7 : init r7 to LASP, find pred of (r9) 
59 67 Di Q10A 196 30$: cmpl (r?) 9 ; is this predecessor of (r9)? 
12 13 0100 £197 beql setmk 3 yes--go set mark location 
57 67 DO Q10F 198 mov (r7),¢7 ; No=-try next block ; 
F6 «8612 0112 199 bneq 30$ ; loop until found or end of List 
0B 11 0114 200 brb setmk ; go set mark location 
67 59 D0 0116 201 40S: mov l r9,(r7) ; Link predecessor to block 
03 11 0119 202 brb 60$ 
53 59 DO 0118 203 50$: mov r9,r3 ; add new block to front of LAS 
69 58 09 piss soe 60$: movl r8,(r9) ; Link new block to successor 
a181 $09 : Set location to be marked by next call of pas$mark 
5 59 §=©00 0121 208 setmk: movi r9,r8 ; 78 <- addr of block to allocate 
OOO00014'"EF42 58 #00 biS¢ $10 mov l 8,marks-4(r2) 3; set mark location to new block 
012C 211; Allocate part or all of the block whose address is in r8. Register 6 
012C $i¢ 3 has the number of bytes to allocate, r7 has addr of the predecessor 
biS¢ 1? : =6of the block. 
50 FC AB 56 (C3 Bigs 15 alloc: subl3 6,-4(r8),r0 ; compare sizes 
064 50 0d1 0131 16 cmp r0,#4 ; within 4 bytes? 
1F 614 «40134217 bgtr split i; no--split block 
0136 86218 3: yes--remove whole block from LAS 
57 D5 0136 219 tstl r7 : is there a predecessor? 
05 =«13 Blea $s0 beql 10$ 3 no--remove first block from LAS 
67 68 DO OQ13A $) mov (r8),(r7) ; yes--link predecessor to successor 
03 «11 B10 § ¢ brb 208 
53 68 00 O135F 23 108: mov l (r8),73 3 set mew LASP 
OOOOO014"EF42 58 D1 0142 24 208: cmpl r8 ,marks-4(r2) ; is this marked block? 
36 12 O14A 5 bneq exitmn 3 no--return ’ 
OOO00014"EF42 D4 bree 6 clrl marks~4(r2) > yes--set mark to nil 
2D =Ss11 B22 st brb exitmn 3; return 
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6132 9; Split block whose address is in r8. Register 7 has address of 
01 2 0; predecessor of this block, r0 has number of bytes left over after 
0155 ; «split, r6 has number of bytes to allocate. 
FC A 56 dO 0155 split: mov l r6,-4(r8) ; set size of alloc block 
59 oH 56 «6C1. «(0159 4 addl\3—s r6,r8,r9 ; 79 <= addr of remainder 
FC AO «6550 DO 015D 5 mov l r0,-4(r9) 3; set size of remainder 
69 4 D 161 § mov | (eB), (r9) ; set Link of remainder 
5 ) 164 tstl r7 ; is there a predecessor? 
05 13 0166 8 beql 10$ i; no--Link to beginning of LAS 
67 59 Do 0168 39 movl r9,(r7) ; link predecessor to block 
03 11 0168 40 brb 20$ 
53 DO 016D 41 10$: mov r9,r3 ; set new head of LAS 
QOOOO00I4"EF42 58 D1 0170 4g 20$: cmpl r8,marks-4(r2) ; is this marked block? 
08 12 0178 4 bneq exitmn 3 no--return 
QOOO000I4"EF42 59 DO Bie ste mov | r9,marks-4(r2] i; yes--set mark to remainder 
8185 $78 ; Store values that may have been changed, set return value, return. 
0182 248 exitmn: ; exit from pas$mark or pas$new 
FFFFFFFC‘EF42 53 DO 0182 4 movl r3,lasps- rg 3; store LASP 
OO000004'EF42 54 DO 018A 50 movl r4,pblos-4Er2] 3; store PBLP 
QOOOOOOC'EF42 55 D0 0192 251 movl 3 -B90 s-4(r2] ; store pool pointer 
08 BC 58 00 019A $2¢ mov | r8,a8(ap) ; return pointer to allocated block 
Q00000020'EF 97 O19E 25 decb nestl i; reset nesting level 
oa Be, Pai 
Bie $28 3; ROUTINE TO IMPLEMENT THE PASCAL PROCEDURE MARK 
O1AS «= 2 58 ; This routine functions as a second entry point for pas$new, sharing 
BiA2 $23 : much of the code of that routine. 
O3FC BIA se} entry pasSmark,“m<r2,r3,r4,r5,r6,r7,78,r9> 
Bir ser ; Move important values to registers 
Q0000020'EF 96 O1A7 265 incb nestl : increment nest level 
52  00000020°EF 9A OI1AD 266 movzbl nestl,r ; r2 <~ incremented nesting level 
53 Seopnnns eres DO 0184 267 mov t lLasps~4 rg] FF ; r3 <= LASP for this leve 
54 00000004'EF4 DO O1BC 268 mov | pblos-4(r2),r4 ; 74 <= PBLP for this level 
55 QOO0000C'EF42 D0 O1C4 69 mov l pools-4(r2),r5 : 5 <= addr of first block of pool 
56 04 AC 00 pice o movl 4(ap),.r6 : 76 <- # of bytes to allocate 
ate i 3; If current marked block exists & is large enough, take it. 
57 53 00 8108 74 mov l r3,r7 3 r7? <= LASP 
58  Q0000014'EF42 DO O1D 75 mov l marks-4(r2),r8 ; 78 <- addr of marked LAS block 
16 13 0108 76 beql locend 3 no marked block--find end of LAS 
56 FC AB ODI 3108 77 cmpl -4(r8),r6 ; is marked block big enough? 
10 19 Q1E1 78 blss locend ; no--find end of LA 
Bie 79 ; yes--find predecessor of marked block 
58 67 D1 OIE 80 10S: cmpl (r7),r8 ; is this predecessor of marked block? 
03 12 O186 81 bneq 20 3 no=--keep looking 
FF41 31 OQ1E8 8 brw alloc 3 yesq-go allocate the marked block 
57 67 DO O1EB 83 20$: mov l (r7),r7 : else try next block 
3. aa ee Hf bneq 10$ ; loop until found or end of LAS 
FF39 «-31—sOO1F 5 brw alloc ; go allocate the marked block 
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Q1F 
bie 
1F 
1F 
1F 
28 D4 OIF 
>) DS QF 
03 12 QIF? 
FES? = 351 O1F9 
67 05 Rite 
de HB 
VD Ht 8 
. 3. 9 88 
020 
og 08 
0208 
O3FC 0208 
OSoa 
020A 
020A 
QOO00020"EF 96 O20A 
52  00000020'EF 9A 0210 
53 FFFFFFFC'EF42 00 0217 
54 QO0000004"EF42 D0 O2IF 
> oe Ossie 
00000020°EF 97 0229 
04 O22F 
55 QO00000C"EF42 DO 0230 
56 604 BC «(DO (0238 
023C 
023C 
023C 
023¢ 
Oe ec 
57) 54) =600 Ss (023C 
56 57 D1 «(025F 
OA 1A 0242 
50 57 ~6FC AP C1 0244 
56 50 D1 0249 
OC 1A O24C 
57 67) «600 «—(O24E 
EC is 0251 
Q00000020°EF 9 8 53 
04 59 
O25A 
025A 
OSea 
025A 
025A 
57 54) =—TO25A 
2B 13 0250 
28 D4 SF 
~- SB 00 61 
20 1 64 
59 4 01 66 
08 iF 69 
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; Current marked block was not big enough. Find end of LAS, go try to 
; get marked block from pool, or else get it by expanding memory. 
locend: ; locate end of LAS 

clrl r ; r8 <= nil successor 

tstl r 3; LASP is nil? 

bneq 10$ 3; no--find end of LAS 

brw inpool i yes--go find block to mark 
108: tstl (r7) ; r? is last LAS block? 

bneq 208 3 no=-keep looking 

brw inpool 3; yes--go find block to mark 
20$: 3; else try next block 


¢ 
; loop until last block found 
: ROUTINE TO IMPLEMENT THE PASCAL PROCEDURE RELEASE 

-entry pas$release,*m<r2,r3,r4,r5,r6,r7,°8,r9> 


cs 
> 
cs 
» 


: Move important values to registers 


; Make sure that the block containing the addr to be released is on the 
; PBL of this nesting level. If so, set r7 to addr of the page block 
3 containing the released address. If not, there is nothing to do. 


mov | r4,r7 ; init r7 to first page block 
208: cmpl r7,r6 : freed addr before this block? 
bgtry 30 3 yes--loop to next block 
addl$ = -4(r7),r7,r0 3; 70 <- addr of end of block 
cmpl r0,r6 3; freed addr inside this block? 
bgtru = pool : yes--go add blocks to pool 
30$: mov l (r7),r7 3 no--try next block . 
bneq 20$ ; loop until found or end of List 
decb nestl ; block not found--nothing to do 
ret ; back to caller 
Add the freed blocks to the pool, kept sorted in memory order. | 
Register 4 has address of next block to add to pool, r8 and r9 find 


the spot to insert the block. 


incb nestl : increment the nesting level 
movzbl nestl,r2 3 re <- fe ye egg Fg phe, level 
mov l lLasps-4(r2),r3 3; r3 <= LASP for this Lleve 

mov pblos-4Urcs.ré ; 74 <= PBLP for this level 

bneq 0$ ; continue if not nil 

decb nestl ; PBLP is nil--nothing to do 

ret ; back to caller 

movl ools-4Cr2),r5 3; 5 <= addr of pool for this level 
mov l 4(ap),r ; 76 <= addr to be released 


Page 


ool: cmpl r4,r7 3; this block contains freed addr? 
beql part : yes--done adding to pool 
clei re : 78 finds predecessor of added block 
movl r5,r9 3; ©9 finds successor of added block 
10$: beql 20$ : end of List--add new block 
cmpl r4,r9 ; new block goes before (r9)? 
blssu 208 3 yes~-add new block 
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28 59 =b0 68 43 mov | r9,r8 3 no--try next block 
9 69 00 oF 44 movi =: (9), 9 
Fi 11 45 brb 10$ ; loop until spot found 
58 be 7 46 208: tstl r8 ; is there a predecessor? 
05 1 7 47 beql 30$ ; no=-add to front of pool 
68 54 00 7 48 mov l r4,(r8) ; else Link predecessor to new block 
03 11 O27A 349 brb 40$ 
s 36 06 7C 50 30$: movl r4,r5 ; add new block to front of pool 
50 «664 ~—CO 6 7F «6351 40$: =move ~— (rd), r 0 ; save addr of next block of PBL 
64 59 00 Be 26 mov r9,(r4) ; Link new block to successor 
54 50 dO 028 5 mov r0,r4 3 move to next block of PBL 
dO.) O «11 Rsee 23 brb pool ; loop through all freed blocks 
028A 56; Find the spot in LAS for the freed storage in the page block containing 
028A 57 ; the freed pointer. LAS is also kept sorted in memory order. Register 6 
028A 58 ; has the address of the freed storage, r8 and r9 find the correct spot 
BSBA aR > in LAS for the new free block. 
58 D4& O2BA 361 part: clrl r8 ; 78 finds predecessor of new block 
59 53 00 O28C ¢ movl r3,r9 3; 79 finds successor of new block 
OD 13 O28F 363 10$ beql 208 : end of list--add new block 
59 56 D1 0291 364 cmpl r6,r9 3; new block goes before (r9)? 
08 iF 0294 365 blssu 20 : yes--add new block 
58 59 DO 0296 366 mov l r9,r8 3 no=-try next block 
59 69 DO 0299 367 movil = (r 9), 9 
Fl 11 O029C 368 brb 10$ ; loop until spot found 
58 DS O29E 369 208 tstl r8 ; is there a predecessor? 
05 13 Q2A0 370 beql 30$ ; no=-add to front of LAS 
68 56 D0 O2A2 371 movl r6,(r8) ; else Link predecessor to new block 
03 11 O2A5 36 brb 40$ 3 go set mark loc 
53 56 DO O2A7 373 308: mov | r6,r3 ; add new block to front of pool 
OO000014"EF42 56 00 bsaa ee 40$: mov l r6,marks-4(r2] 3 next spot to mark is (r6) 
02B2 358 ; Compute size of newly-added block, and remove from LAS all former 
O2B2 377; free blocks falling inside the new block. Register 6 is address of 
02B2 $8 ;  mewly-added block, r9 is successor of block, r7 is addr of page block 
0565 44 3 containing the new free block. 
50 FCA? 57 (C1 ose 381 size: addl3  r7,-4(r7),r0 ; r0 <= addr of end of page block 
FC A6 «65500 |=6556——iC<CE}s«ONB 306 subl3 r6,r0,-4(r6) ; set size of new block 
59 D5 O2BC 38 tstl r9 ; 
OA 13 O2BE the beql 20$ ; end of List--set successor 
50 59 D1 O02C0 85 10$: cmpl r9,r0 ; this block inside new free block? 
05 1A 0 Ce +) bgtru 20$ 3; mno--set successor 
59 669) =—Os«ONRC 8 mov | (r9),79 3 poem try next block  —_—iyT 
F6 «612 «02C8 88 bneq 0$ ; loop through all possibilities 
66 59 00 8 . SP 208: mov | r9,(r6) 3 set successor of new block 
$5eD 91; Try to merge newly-freed storage with predecessor in LAS. Register 7 
O5¢0 5 ; has the address of the predecessor, r6 has the address of the new block. 
58 05 $5¢D 94 tstl r8 ; is there a predecessor? 
1A 13° O2CF 95 beql removl : No--go remove other garbage 
50 FC AB 58 (C1 0Q2D1 96 addi3 8, -4(r8),r0 ; r0 <= addr of end of predecessor 
50 56 O01 8 D6 97 cmpl r6,r0 ; is new block adjacent? 
7 <a d9 98 bneq removl 3 no--go remove other garbage 
FC AB FC AB CO O2DB SY addl2s_ -4(r6),-4(r8) 3 yes--lengthen predecessor 
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| PASSRT_HEAP 16-SEP-1984 02:08:58 VAX/VMS Macro V04-00 Page 8 PAS 
vO4=000 SEp= 1984 09:50:48 EPASCAL. SREIPASRTD. MAR; 1 ~ om v04 
6 6 dO E 400 mov (r6), (r8) ; set Link of predecessor 
00000014 "EF SS 8 dO 6 ES 631 mov l r8,marks-4(r2) 3; next spot to’ ert is (r8) 
6 EB 208 3 Remove from LAS all storage contained in blocks now in the pool. 
O2EB 404 ; Register 7 has address of next page block to check, r8 has address 
O2EB 405; #£4of predecessor of next LAS block to check, r9 has address of next 
O2EB 406; LAS block to check. 
O2EB 407 ; 
O2EB 408 removl: 3; remove garbage from LAS 
58 04 O2EB 409 clrl rg ; initialize r8 to nil predecessor 
9 635 0 8 ED 410 mov l r3,r9 ; initialize r9 
3] 1 FO 411 beql exitr : no LAS--exit 
57 5 0 OeF rt movl r5,r7 ; initialize r7 
2C)6 «6 130 F 41 beql exitr ; empty pool-exit 
50 57 FC A? (C1 O2F? 414 108: addl3- =4(r7),r7,r0 ; 70 <= addr of end of this page block 
57 59 D1 O2FC 415 208: cmpl r9,r7 ; LAS block starts after page block? 
OA 1A Ort 416 bgtru 40$ > yes--look for garbage 
58 59 DO Q301 417 mov r9,r8 3 No--try next LAS block 
59 69 DO 0304 418 30$: mov l (r9), 09 ; move r9 to successor 
1A 3613 «(0307 )~ = 419 beql exitr 3; end of LAS--exit 
Fi 11 Q309 420 orb 20$ 3 loop tg all LAS blocks 
50 59 01 OQO30B 421 40$: cmp r9,r0 ; LAS block inside page block? 
OE ‘tA O30E $56 bgtru 60$ 3 no--try next page block 
0310 42 3 yes--remove garbage LAS block 
58 D5 0310 424 tstl r8 ; is there a predecessor? 
05 13 Q312 $82 beaql 50$ 3 no--delete first LAS block 
68 69 D0 0314 426 mov (r9), (r8) i; yes--delete successor of r8 
EB 11 #O317 427 brb 30$ ; - try next LAS block 
53 69 DO 0319 428 50$: mov (r9),r3 ; delete first LAS block 
E6 11 O31C $$3 brb 30$ ; go try next LAS block 
57 67 DO OQ31E 430 608: mov (r7),r7 3; try next page block 
D4—ssi2 O3Ss $3! bneq 10$ ; loop through all page blocks 
O3S3 635 : Store values that may have changed, return to caller 
FFFFFFFC'EF42 53 DO 0323 435 exitr: movl r3,lasps-4(r2) 3; store LASP 
OOOOD004'EF42 54 00 bee 436 mov l r2 pel ps=? re] ; store PBLP 
OOOOOOOC"EF42 55 DO Q3 437 mov l r5,pools-4(r2] ; store pest pointer — 
04 BC 04 0338 438 clrl a4 (ap) ; set released ptr to nil 
O0000020'EF 97 O33E 439 decb nest 3; reset nesting level 
st ER Pele 
Bete Prk : ROUTINE TO IMPLEMENT THE PASCAL PROCEDURE DISPOSE 
OOFC O33 ret entry pas$dispose,*m<r2,r3,r4,r5.r6,r7> 
O30) ry. ; Move important values to registers 
OOOOO020'EF 96 0347 448 incb nestl ; increment nesting level 
52. 00000020'EF 9A 0340 449 movzbl nestl.r : re <- incremente Rept ins Level 
53 Se nonas eres dO Oeee 450 mov l lLasps~4 roq.r3 ; r3 <= LASP for this leve 
54 00000014°EF4 DO $f 451 mov marks-4(r2),r4 : 74 <= addr of marked blk 
55 04 BC DO 0364 $26 movi a4(ap).r5 ; tS <= addr of block to be disposed 
03 12 68 45 bneq 108 ; continue if not nil 
0084 31 6A 454 brw exitd ; Nil pointer--exit 
55 0000000 oF » 9p 455 10$: bitl #*xc0000000.r5 ; check for illegal value 
0 13 0374 456 beql Look 3; continue if not system or stack addr 
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v04-006 moet $5: 98:28 UPASCAL. SREJPASRT2_MAR: 1 ° (1) 
7E 10 AD o? C3 76 8457 subl3) #7,16(fp),=(sp) ; third FAO argument (PC of call) 
9 DD 7B «458 pushl # 3 second FAO argument (null) 
5 DD 7d 3=«6459 pushl fr 3; first FAO pogunent (invalid pointer value) 
03 DD O37F 460 push # mae ; number of FAO arguments preceding 
7E QO0000000'SF 04 Ci 0381 461 addl5 #4, #pas$_attdisinv,-(sp) ; error message #8160 
C'EF 97 0389 re} decb nest ; reset nesting level 
00000000'GF 05 FB te $07 calls #5,G*lib$stop 3; signal error and stop execution 
0396 465 ; Look through LAS for the spot to insert the disposed block. Register 5 
0396 466; has address of disposed storage, r6é finds the predecessor of the new 
baoe reff ; block, r? finds the successor of the new block. 
b396 469 look: ; look for spot to insert block 
56 «604 «6400396 ) = 470 clrl r6 ; initialize predecessor to nil 
57. 553) «DO «20398 = 471 mov l r3,r7 ; initialize successor to LASP 
OD 13 0398 te8 beql insert ; LAS is empty--insert new block 
57 55 01 Q39D 473 108: cmpl r5,r7 ; mew block goes before (r7)? 
08 %1F Q3A0 474 blssu._— insert 3; yes--go insert it 
56 57 DO O3A2 475 mov r7,r6 3 No=-try next block 
5? 67 «60 03A5) = 476 movil ss (rr?) sr? 
fs. te Bean ri 44 bneq 10$ ; loop until found or end of LAS 
Q3AA 479; Insert new block into LAS, merging with predecessor or successor if 
Q3AA 480 ; possible. Register 5_has addr of disposed block, r6 has addr of 
ae re} 3 predecessor in LAS, r7 has addr of successor in LAS. 
O3AA re insert: ; insert new block into LAS 
50 55 FC AS C1 Q3AA 486 addl3_- -4(r5),r5,r0 ; r0 <= addr of end of disposed block 
57 50 D1 OQ3AF 485 cmp r0,r7 ; is new block adjacent to successor? 
12 12 0382 486 bneq 10 3 no--Llink to successor 
FC AS FC A? CO 0384 487 addl2.-_ =4(r7),-4(r5) 3; yes--merge with successor 
65 67 DO 0389 488 movl (r7),¢r ; set Link of new block 
54 57 D1 O3BC 489 cmpl sr 7, r ; was successor the marked block? 
08 12 O3BF 490 bneq 20 3 no--try to merge with predecessor 
54 55 DO O3C1 491 mov r5,r4 : yes--new block is now marked 
03 11 03C4 ane brb 20 ; 
65 57 DO 03C6 493 108: mov r7,(r5) : Link new block to successor 
56 DS 03C9 494 208: tstl r6 ; is there a predecessor? 
05 12 O3CB 495 bneq 30$ 3 a try to aeree 
53 55 DO O3CD 496 mov | r5,r3 ; No--add new block to front of LAS 
1F 611 0300 497 brb exitd ; exit 
50 56 FC AB C1 tty) 498 30$: addl\3 _ -4(r6),r6,r0 ; 70 <- addr of end of predecessor 
50 55 D1 03D 499 cmpl r5,r0 ; mew block is adjacent to predecessor? 
le is B0A 500 bneq 40 3; no--go Link predecessor to new block 
FC A6 =FC A CO O3DC 501 addli2-_- -4(r5),-4(r6) 3 yes--lengthen predecessor 
66 65 00 0Q3E1 208 mov | (r5),¢r ; set Link of predecessor 
54 55 01 O3€4 50 cmp r5,.r4 ; was new block the marked block? 
08 12 Q3E7 504 bneq exitd 3 No=-exit , 
54 56 00 O3€9 505 mov r6,r4 3 yes--predecessor is now marked 
03 11 Q3EC 506 brb exitd 3 ext 
66 55 00 Bees ene 40$: mov | r5,(r6) : link predecessor to new block 
Bari a4 : Store values that may have changed, return to caller 
FFFFFFFC°EF42 53 DO a3 214 exitd: movl r3,las swotrsd 3 store LASP 
QO000014"EF42 54 D0 O3F9 216 mov r4,marks-4(r ; store addr of marked block 
04 BC D4 0401 $1 clrl a4 (ap) ; set disposed ptr to nil 


unappealing naindipgtiatgrioimidssaapatitaiagatiiiantdiaaianpilees 


—_——_—_ Lh 


:° 9 
PASSRT_ HEAP 16-SEP-1984 :08:5 AX/VMS Macro Vv04-00 Page 10 
v04-006 -SEP-1984 $5: 98:28 PASCAL. SRCJPASPT2.MAR; 1 . (1) 
QOOOO0O2Z0"EF 97 0404 514 decb nestl 3; reset nesting level 
04 ike $16 ret 
9443 317 : DEBUGGING ROUTINE TO EXAMINE STATE OF HEAP STORAGE 
0000 0408 219 ‘ .entry pas$snap,“m<> 
a¢0p : Return current values of level 1 LASP, PBLP, POOL, MARK 
04 BC QOOO00000'EF DO 0400 5 : : mov l Lasps,a4(ap) ; return Llasp 
08 BC OO0000008'"EF DO 0415 524 movl pblps,a8(ap) 3; return pblp 
Oc BC aii 4 DO 0410 2 5 mov pools,a12(ap) 3; return pool 
10 BC G0000018'EF dO be Sp 6 mov l marks,a16(ap) ; return mark 
04 042D aH ret 
042E 528 .end 
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PASSRT_HEAP 1 4 5 AX/VMS Macro v04-00 Page 11 PAS 
Symbol “table $73 71982 85: 98: 2g PASCAL. RCIP ASRT2.MAR; 1 ° (1) VAX 
ALLOC pop Te R 0 Ass 
EXITD OO0003F1 R 0 
X1TMN 3008 18S R i) The 
XITR 00000325 R 0 362 
EXPAND HOOD On R 0 The 
INPOOL aN g 8 165 
INSERT QOOOO3SAA R 1p 
LASPS 00000000 R ¢ 
LIBSGET_VM eeeerere KX | 
LIBSSTOP eeereree XK 05 
LINKLA 000000D5 R 0 
LINKPB QOOOOOAD R 0 
LOCEND QOOOOIFS R 0 Mec 
OOK 00000396 R 03 —_ 
MARKS 00000010 R 02 ~82 
NESTL 00000020 R b¢ 
PART 0000028A R 0 06 
PASSDISPOSE 00000345 RG 03 
PASSMARK 000001A5 RG 03 The 
PASSNEW 00000000 RG 03 
PASSRELEASE 00000208 RG 03 MAC 
PASSSNA 00000408 RG 03 
PASS SAT TDISINV teerenree 00 
PAS$_PROEXCHEA keeeeere x 00 
PBLPS 00000008 R ¢ 
L 0000025A R 0 
LS 0000010 R 02 
REMOVL OOOO2EB R 03 
SE TMK 00000121 R 03 
IZE 000002B2 R 03 
SPLIT 00000155 R 03 
$ewmwowoeoowewene * 
' ;_Psect synopsis ! 
PSECT name Allocation PSECT No. Attributes 
ABS . 00000000 0.) OO ¢ QO.) NOPIC USR CON ABS - LCL NOSHR NOEXE NORD NOWRT NOVEC BYTE 
SABSS$ 00000000 ( 0.) O1 1.) NOPIC USR CON ABS LCL NOSHR EXE RD WRT NOVEC BYTE 
_PASSDATA 00000021 < 33.) 02 ¢ §:} PIC USR CON REL LCL NOSHR NOEXE RD WRT NOVEC LONG 
“PASSCODE 0000042E ( 1070.) 03 ¢ ai PIC USR CON REL LCL SHR EXE RD NOWRT NOVEC BYTE 
Siiciceninmennasanendil 
! ; Performance indicators ! 
Phase Page faults CPU Time Elapsed Time 
Initialization 31 00:00:00.09 00:00:00.33 
Command processing 106 00:00:00.48 00:00: ‘Re: -64 
Pass 1 136 00:00:02.17 00:00:05.42 
Symbol table sort 0 BO: OP: By -08 00:00:00.06 
Pass 112 00:00:01.1 Bo? B06 “BY 
Symbol table output ; 00:00:00.04 00:00:00.04 
Psect synopsis output 00:00:00.03 00:00:00.03 
Cross-reference output 0 00:00:00.00 00:00:00.00 
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PASSRT_HEAP 1 4 :5 
VAX=11" Macro Run Statistics g73e 71984 88: 98: 28 t 
Assembler run totals 394 00:00:04.02 00:00:11.22 

138 working es$ Limit was 1400 pages. 

13384 bytes (27 pages) of virtual memory were used * buffer the intermediate code 


328s were 10 pages of symbol table space Pind ng gt 9 hold 65 non-local and 46 local symbols. 
source Lines were read in Pass 1, producin object records in Pass 2. 
8 pages of virtual memory were used to define 7 macros. 


Macro Library name Macros defined 
“S$255$DUAZ8:(SYSLIBJSTARLET.MLB;2 (i‘(Csét*S*S*”*:S~S™S ee 
91 GETS were required to define 4 macros. 

There were no errors, warnings or information messages. 


MACRO/DISABLE=TRACE/LIS=LIS$:PASRT2/0BJ=OBJ$:PASRT2 MSRC$:PASRT2/UPDATE=(ENH$:PASRT 2) 


293 AH-BT13A-SE—s_~s- : PMENT CORPORATION 
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